Gigarom 1/Gigarom Macintosh Archives (Quantum Leap)(CDRM1080320)(1993).iso/FILES/DEV/A-B/Anim Cursor.cpt/pascal/CursorCtl.lsp

Text File | 1990-01-22 | 6KB | 198 lines

unit CursorCtl;

{Routines to use an animated cursor}

interface

    type
        acur = record
            frameCount: integer;    {Number of frames in animation sequence}
            whichFrame: integer;    {Current frame}
            frame: array[1..1] of CursHandle;    {the list of "CURS" resources representing sequence (IDs and handles)}
        end;
        acurPtr = ^acur;
        acurHandle = ^acurPtr;

    var
        FrameList: acurHandle;    {handle to "acur" resource}
        CursVBL: VBLTask;    {VBL task to handle cursor animation}
        CursAnimationEnabled: BOOLEAN;    {True if able to load "acur" and associated "CURS" resources}
        CursSpeed: INTEGER;        {Number of ticks between consecutive cursor frames}
        CursAlreadyOn: BOOLEAN;    {True if cursor animation is already running}

    procedure InitCursAnimation (acurID: INTEGER    {Rsrc ID of "acur" resource}
                                    );
    procedure AnimateCursor (speed: INTEGER        {ticks between consecutive frames}
                                    );
    procedure StopCursor;


implementation

{============ SetCurrentA5 ==============================================}

{This routine sets up the A5 to point to the boundary between the application globals }
{ and the application parameters. It returns the previous value of A5. This function is}
{used instead of SetUpA5 which is dangerous as it does not return the old value of A5}
{but rather leaves it on the stack-see tech note #208 for more details}

    function SetCurrentA5: Longint;
    inline
        $2E8D, $2A78, $0904;

{============ SetA5 ==============================================}

{ This routine sets the value of A5 to "newA5". It should be used to restore the old value }
{of A5 at the end of a completion routine or a VBL task. It also returns the previous value}
{ of A5. This function is used instead of RestoreA5 which assumes the old value of A5}
{is still on the stack-see tech note #208 for more details}

    function SetA5 (newA5: Longint): Longint;
    inline
        $2F4D, $0004, $2A5F;

{============ SetWatchCursor ==================================================}

    procedure SetWatchCursor;

        var
            mycursor: CursHandle;

    begin
        mycursor := GetCursor(watchCursor);
        SetCursor(mycursor^^);
    end; {SetWatchCursor}

{============ InitCursAnimation =====================================================}

{This procedure tries to load the "acur" resource and if found tries to load all the "CURS" resources}
{listed in the "acur" resource}

    procedure InitCursAnimation (acurID: INTEGER    {Rsrc ID of "acur" resource}
                                    );

        var
            i, errorcode: integer;

    begin
        FrameList := acurHandle(GetResource('acur', acurID));    {Get the "acur" resource}
        errorcode := ResError;

        if FrameList = nil then
            errorcode := ResNotFound;

        if errorcode = noErr then
            begin
                i := 1;
                while (i <= FrameList^^.frameCount) and (errorcode = noErr) do
                    begin
        {Get the "CURS" resources whose ID's are in the high word of the frame field.  Store handle to these}
        {resources in the same frame field}
                        FrameList^^.frame[i] := GetCursor(HiWord(LONGINT(FrameList^^.frame[i])));
                        errorcode := ResError;
                        if FrameList^^.frame[i] = nil then
                            errorcode := ResNotFound;
                        i := SUCC(i);
                    end;
                FrameList^^.whichframe := 1;    {Set initial frame}
            end;

        CursAnimationEnabled := errorcode = noErr;    {True if no error is found}
    end;    {InitCursAnimation}

{============ CursorAnimationVBL =====================================================}

{VBL routine to set the cursor to the next cursor in the animation sequence}

    procedure CursorAnimationVBL;

        var
            oldA5: LONGINT;

    begin
        oldA5 := SetCurrentA5;

{FrameList and all frame handles are assumed to be locked}
        with FrameList^^ do
            begin
                SetCursor(frame[whichFrame]^^);

                whichFrame := SUCC(whichFrame);
                if whichFrame > frameCount then
                    whichFrame := 1;
            end;    {with}
        CursVBL.vblCount := CursSpeed;    {Reinstall the VBL}

        oldA5 := SetA5(oldA5);
    end;    {CursorAnimationVBL}

{============ AnimateCursor =====================================================}

{Install out task in the vertical retrace queue unless cursor animation is not enabled then use watch cursor}

    procedure AnimateCursor (speed: INTEGER        {ticks between consecutive frames}
                                    );

        var
            errorcode, i: integer;

    begin
        if not CursAlreadyOn then
            begin
                CursAlreadyOn := TRUE;

                if CursAnimationEnabled then
                    begin
    {Lock all handles that will be accessed from the VBL}
                        HLock(Handle(FrameList));
                        for i := 1 to FrameList^^.frameCount do
                            HLock(Handle(FrameList^^.frame[i]));

                        FrameList^^.whichframe := 1;    {Set initial frame}

    {Set up the VBL task fields and install it}
                        with CursVBL do
                            begin
                                qType := ORD(vType);
                                vblAddr := @CursorAnimationVBL;
                                vblCount := speed;     {next VBL after "speed" ticks}
                                vblPhase := 0;
                            end;    {with}
                        errorcode := VInstall(@CursVBL);

                        CursSpeed := speed;    {Set the speed of animation}
                    end
                else    {Use watch cursor}
                    SetWatchCursor;
            end;    {if}
    end;    {AnimateCursor}

{============ StopCursor =====================================================}

{remove the VBL task from the vertical retrace queue and restore the arrow cursor}

    procedure StopCursor;

        var
            errorcode, i: integer;

    begin
        if CursAlreadyOn then
            begin
                CursAlreadyOn := FALSE;

                if CursAnimationEnabled then
                    begin
                        errorcode := VRemove(@CursVBL);

    {Unlock all handles that were locked before VBL installation}
                        HUnLock(Handle(FrameList));
                        for i := 1 to FrameList^^.frameCount do
                            HUnLock(Handle(FrameList^^.frame[i]));
                    end;    {if}

                InitCursor;
            end;    {if}
    end;    {StopCursor}

end.